home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 21 / QRZ Ham Radio Callsign Database - Volume 21.iso / DEVELOP / QRZDEMO.FRM < prev    next >
Text File  |  2000-10-29  |  10KB  |  371 lines
  1. VERSION 5.00
  2. Begin VB.Form QRZDemo 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "QRZ Sample Application"
  6.    ClientHeight    =   3375
  7.    ClientLeft      =   795
  8.    ClientTop       =   1995
  9.    ClientWidth     =   6420
  10.    FillColor       =   &H00FFFFFF&
  11.    BeginProperty Font 
  12.       Name            =   "MS Sans Serif"
  13.       Size            =   8.25
  14.       Charset         =   0
  15.       Weight          =   700
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    LinkTopic       =   "QRZDemo"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   3375
  24.    ScaleWidth      =   6420
  25.    Begin VB.CommandButton Command7 
  26.       Appearance      =   0  'Flat
  27.       Caption         =   ">>"
  28.       Height          =   312
  29.       Left            =   2640
  30.       TabIndex        =   10
  31.       Top             =   1440
  32.       Width           =   672
  33.    End
  34.    Begin VB.CommandButton Command6 
  35.       Appearance      =   0  'Flat
  36.       Caption         =   "<<"
  37.       Height          =   312
  38.       Left            =   300
  39.       TabIndex        =   9
  40.       Top             =   1440
  41.       Width           =   672
  42.    End
  43.    Begin VB.CommandButton Command5 
  44.       Appearance      =   0  'Flat
  45.       Caption         =   "Continue"
  46.       Height          =   312
  47.       Left            =   4500
  48.       TabIndex        =   8
  49.       Top             =   2520
  50.       Width           =   1032
  51.    End
  52.    Begin VB.CommandButton Command4 
  53.       Appearance      =   0  'Flat
  54.       Caption         =   "Count"
  55.       Height          =   312
  56.       Left            =   4440
  57.       TabIndex        =   7
  58.       Top             =   1440
  59.       Width           =   732
  60.    End
  61.    Begin VB.CommandButton Command3 
  62.       Appearance      =   0  'Flat
  63.       Caption         =   "<"
  64.       Height          =   312
  65.       Left            =   1080
  66.       TabIndex        =   0
  67.       Top             =   1440
  68.       Width           =   672
  69.    End
  70.    Begin VB.CommandButton Command2 
  71.       Appearance      =   0  'Flat
  72.       Caption         =   ">"
  73.       Height          =   312
  74.       Left            =   1860
  75.       TabIndex        =   5
  76.       Top             =   1440
  77.       Width           =   672
  78.    End
  79.    Begin VB.CommandButton Command1 
  80.       Appearance      =   0  'Flat
  81.       Caption         =   "Search"
  82.       Default         =   -1  'True
  83.       Height          =   312
  84.       Left            =   3300
  85.       TabIndex        =   4
  86.       Top             =   2520
  87.       Width           =   1032
  88.    End
  89.    Begin VB.TextBox Text2 
  90.       Appearance      =   0  'Flat
  91.       Height          =   288
  92.       Left            =   1860
  93.       TabIndex        =   2
  94.       Text            =   "a"
  95.       Top             =   2520
  96.       Width           =   1272
  97.    End
  98.    Begin VB.TextBox Text1 
  99.       Appearance      =   0  'Flat
  100.       BeginProperty Font 
  101.          Name            =   "MS Sans Serif"
  102.          Size            =   9.75
  103.          Charset         =   0
  104.          Weight          =   700
  105.          Underline       =   0   'False
  106.          Italic          =   0   'False
  107.          Strikethrough   =   0   'False
  108.       EndProperty
  109.       Height          =   1212
  110.       Left            =   120
  111.       MultiLine       =   -1  'True
  112.       TabIndex        =   1
  113.       Text            =   "qrzdemo.frx":0000
  114.       Top             =   60
  115.       Width           =   6192
  116.    End
  117.    Begin VB.Label Label7 
  118.       Caption         =   "Email:"
  119.       Height          =   255
  120.       Left            =   0
  121.       TabIndex        =   15
  122.       Top             =   3000
  123.       Width           =   615
  124.    End
  125.    Begin VB.Label Email 
  126.       Caption         =   "Label6"
  127.       Height          =   375
  128.       Left            =   720
  129.       TabIndex        =   14
  130.       Top             =   3000
  131.       Width           =   5655
  132.    End
  133.    Begin VB.Label Label5 
  134.       Appearance      =   0  'Flat
  135.       BackColor       =   &H80000005&
  136.       BackStyle       =   0  'Transparent
  137.       BeginProperty Font 
  138.          Name            =   "MS Sans Serif"
  139.          Size            =   12
  140.          Charset         =   0
  141.          Weight          =   700
  142.          Underline       =   0   'False
  143.          Italic          =   0   'False
  144.          Strikethrough   =   0   'False
  145.       EndProperty
  146.       ForeColor       =   &H80000008&
  147.       Height          =   312
  148.       Left            =   2100
  149.       TabIndex        =   13
  150.       Top             =   2040
  151.       Width           =   4272
  152.    End
  153.    Begin VB.Label Label4 
  154.       Alignment       =   2  'Center
  155.       Appearance      =   0  'Flat
  156.       BackColor       =   &H80000005&
  157.       BackStyle       =   0  'Transparent
  158.       BeginProperty Font 
  159.          Name            =   "MS Sans Serif"
  160.          Size            =   18
  161.          Charset         =   0
  162.          Weight          =   700
  163.          Underline       =   0   'False
  164.          Italic          =   0   'False
  165.          Strikethrough   =   0   'False
  166.       EndProperty
  167.       ForeColor       =   &H80000008&
  168.       Height          =   432
  169.       Left            =   60
  170.       TabIndex        =   12
  171.       Top             =   1920
  172.       Width           =   2052
  173.    End
  174.    Begin VB.Label Label3 
  175.       Alignment       =   2  'Center
  176.       Appearance      =   0  'Flat
  177.       BackColor       =   &H80000005&
  178.       BackStyle       =   0  'Transparent
  179.       ForeColor       =   &H80000008&
  180.       Height          =   252
  181.       Left            =   120
  182.       TabIndex        =   11
  183.       Top             =   3000
  184.       Width           =   6192
  185.    End
  186.    Begin VB.Label Label2 
  187.       Alignment       =   2  'Center
  188.       Appearance      =   0  'Flat
  189.       BackColor       =   &H80000005&
  190.       BackStyle       =   0  'Transparent
  191.       Caption         =   "0000"
  192.       ForeColor       =   &H80000008&
  193.       Height          =   192
  194.       Left            =   5220
  195.       TabIndex        =   6
  196.       Top             =   1500
  197.       Width           =   732
  198.    End
  199.    Begin VB.Label Label1 
  200.       Alignment       =   1  'Right Justify
  201.       Appearance      =   0  'Flat
  202.       BackColor       =   &H80000005&
  203.       BackStyle       =   0  'Transparent
  204.       Caption         =   "Callsign:"
  205.       ForeColor       =   &H80000008&
  206.       Height          =   252
  207.       Left            =   840
  208.       TabIndex        =   3
  209.       Top             =   2580
  210.       Width           =   972
  211.    End
  212.    Begin VB.Menu MenuExit 
  213.       Caption         =   "E&xit"
  214.    End
  215.    Begin VB.Menu MenuAbout 
  216.       Caption         =   "&About..."
  217.    End
  218. End
  219. Attribute VB_Name = "QRZDemo"
  220. Attribute VB_GlobalNameSpace = False
  221. Attribute VB_Creatable = False
  222. Attribute VB_PredeclaredId = True
  223. Attribute VB_Exposed = False
  224. Option Explicit
  225.  
  226. Dim StopQRZ As Integer
  227. Dim Spinning As Integer
  228.  
  229. Private Sub Command1_Click()
  230.     Dim tmp As String
  231.  
  232.     StopQRZ = True
  233.     Label3.Caption = ""
  234.     tmp = Text2.Text
  235.     ReturnLen = QRZSearch(QRZCALL, tmp, "", "", Found, DISP_FMT)
  236.     Label2.Caption = QRZGetCount()
  237.     DisplayRecord
  238.  
  239. End Sub
  240.  
  241. Private Sub Command2_Click()
  242.  
  243.     ' Here we advance one record
  244.     ReturnLen = QRZAdvance(1, Found, DISP_FMT)
  245.     DisplayRecord
  246.  
  247. End Sub
  248.  
  249. Private Sub Command3_Click()
  250.  
  251.     ' Back up one record
  252.     ReturnLen = QRZBack(1, Found, DISP_FMT)
  253.     DisplayRecord
  254.  
  255. End Sub
  256.  
  257. Private Sub Command4_Click()
  258.  
  259.     Dim More As Integer
  260.     StopQRZ = True
  261.     Do
  262.         Label2.Caption = QRZCount(More)
  263.         DoEvents    ' to update screen
  264.  
  265.     Loop While More = True
  266.  
  267. End Sub
  268.  
  269. Private Sub Command5_Click()
  270.  
  271.     StopQRZ = False
  272.     Label3.Caption = ""
  273.     Do
  274.         ReturnLen = QRZGetNext(Found, DISP_FMT)
  275.         If ReturnLen > 0 Then
  276.             DisplayRecord
  277.             Label2.Caption = QRZGetCount()
  278.         End If
  279.         DoEvents
  280.         If StopQRZ Then
  281.             Label3.Caption = "Stopped on user request."
  282.             Exit Do
  283.         End If
  284.  
  285.     Loop While ReturnLen > 0
  286.  
  287. End Sub
  288.  
  289. Private Sub Command6_Click()
  290.     
  291.     'Back up 100 records - The number 100 below
  292.     'is only for illustration.  Any value > 1
  293.     'Backs up by 100
  294.     
  295.     ReturnLen = QRZBack(100, Found, DISP_FMT)
  296.     DisplayRecord
  297.  
  298. End Sub
  299.  
  300. Private Sub Command7_Click()
  301.  
  302.     'Advance 100 records - The number 100 below
  303.     'is only for illustration.  Any value > 1
  304.     'advances by 100
  305.     ReturnLen = QRZAdvance(100, Found, DISP_FMT)
  306.     DisplayRecord
  307.  
  308. End Sub
  309.  
  310. Private Sub DisplayRecord()
  311.     Dim tmp As String
  312.     Dim r As Integer
  313.  
  314.     If ReturnLen > 0 Then
  315.         Text1.Text = Left$(Found, ReturnLen)
  316.     End If
  317.     QRZField CALLS, Found, ReturnLen
  318.     If ReturnLen > 0 Then
  319.         Label4.Caption = Left$(Found, ReturnLen)
  320.     End If
  321.     QRZField FULLNAME, Found, ReturnLen
  322.     If ReturnLen > 0 Then
  323.         Label5.Caption = Left$(Found, ReturnLen)
  324.     End If
  325.     Call QRZField(JR, Found, r)
  326.     If r > 0 And Left$(Found, 1) = "." Then
  327.        ReturnLen = QRZGetEmail(Label4.Caption, Found, 128)
  328.     End If
  329.     Email.Caption = Left$(Found, ReturnLen)
  330.     
  331.     
  332. End Sub
  333.  
  334. Private Sub Form_Click()
  335.     StopQRZ = True
  336. End Sub
  337.  
  338. Private Sub Form_Load()
  339.     Dim Drive As Integer
  340.     Dim tmp As String
  341.  
  342.     tmp = UCase$(Command$)
  343.     Drive = QRZInit(tmp)
  344.  
  345.     If Drive = -1 Then
  346.         MsgBox "QRZDLL is in use by another application.", 0, "QRZDEMO"
  347.         End
  348.     End If
  349.  
  350.     If Drive = 0 Then
  351.         MsgBox "Error: The QRZ Databases could not be found.", 0, "QRZDEMO"
  352.     End If
  353.  
  354.     Label3.Caption = "Using QRZ CD in drive " & Chr$(Drive) & ":"
  355.  
  356. End Sub
  357.  
  358. Private Sub MenuAbout_Click()
  359.     MsgBox "This application is designed to show" & Chr$(10) & "how QRZDLL applications are built. " & Chr$(10) & "This program is not supported by QRZ." & Chr$(10) & "Feel free to modify and/or use whatever" & Chr$(10) & "parts of it that you find useful.", 64, "QRZDEMO Application"
  360. End Sub
  361.  
  362. Private Sub MenuExit_Click()
  363.     Dim n%
  364.  
  365.     n = QRZExit()
  366.     ' uncomment the following to see the return value
  367.     'MsgBox "QRZExit returned " & n, 0, "QRZDEMO"
  368.     End
  369. End Sub
  370.  
  371.